home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / Z-Misc Series / (k)zk.d64 / pl0.test3 < prev    next >
Text File  |  2007-03-01  |  953b  |  48 lines
  1. 0010 // CONST M=7, N=85
  2. 0020 // VAR X,Y,Z,Q,R;
  3. 0030 //
  4. 0040 // PROCEDURE MULTIPLY;
  5. 0050 // VAR A,B
  6. 0060 // BEGIN
  7. 0070 //  A:=U; B:=Y; Z:=0
  8. 0080 //  WHILE B>0 DO
  9. 0090 //  BEGIN
  10. 0100 //   IF ODD B DO Z:=Z+A;
  11. 0110 //   A:=2A; B:=B/2
  12. 0120 //  END
  13. 0130 // END;
  14. 0140 //
  15. 0150 // PROCEDURE DIVIDE
  16. 0160 // VAR W;
  17. 0170 // CONST TWO=2; THREE:=3
  18. 0180 // BEGIN
  19. 0190 //  R=X; Q:=0; W:=Y;
  20. 0200 //  WHILE W<=R DO W:=TWO*W;
  21. 0210 //  WHILE W>Y
  22. 0220 //  BEGIN
  23. 0230 //   Q:=(2*Q; W:=W/2);
  24. 0240 //   IF W<=R THEN
  25. 0250 //   BEGIN
  26. 0260 //    R:=R-W Q:=Q+1
  27. 0270 //   END
  28. 0280 //  END
  29. 0290 // END;
  30. 0300 //
  31. 0310 // PROCEDURE GCD;
  32. 0320 // VAR F,G;
  33. 0330 // BEGIN
  34. 0340 //  F:=X; G:=Y
  35. 0350 //  WHILE F<>G DO
  36. 0360 //  BEGIN
  37. 0370 //   IF F<G THEN G:=G-F;
  38. 0380 //   IF G<F THEN F:=F-G;
  39. 0390 //   Z:=F
  40. 0400 //  END;
  41. 0410 //
  42. 0420 // BEGIN
  43. 0430 //  X:=M; Y:=N; CALL MULTIPLY;
  44. 0440 //  X:=25; Y:=3; CALL DIVIDE;
  45. 0450 //  X:=84; Y:=36; CALL GCD;
  46. 0460 //  CALL X; X:=GCD; GCD:=X
  47. 0470 // END.
  48.